unit uMap;

interface

uses
  Types, Graphics, uScript;

const
  Layers = 4;
  SerializableLayers = 3;
  lrNone = -2;
  lrStop = -1;
  lrTerrain = 0; 
  lrObj = 1;
  lrCrt = 2;
  lrPath = 3;

  AggrZone = 1;

type
  TLayer = array[0..255, 0..255, 0..Layers - 1] of ShortInt;

  TMap = class(TObject)
  private
    FHeight: Integer;
    FWidth: Integer;
    procedure SetHeight(const Value: Integer);
    procedure SetWidth(const Value: Integer);
  public
    Script: TScript;
    MiniMap: TBitmap;
    FMap: TLayer;
    constructor Create;
    destructor Destroy; override;
    property Width: Integer read FWidth write SetWidth;
    property Height: Integer read FHeight write SetHeight;
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure Generate(AID: Byte);
    procedure MakeMiniMap;
    procedure MakeMap;  
    procedure Terrain;
    function GetGroundSet: Byte;
    procedure Fill(Ground: Boolean);
    procedure SetPath(X, Y: Byte; Value: ShortInt); overload;
    procedure SetPath(Pt: TPoint; Value: ShortInt); overload;    
    function CellInMap(X, Y: Integer): Boolean;
  end;

const
  GroundSet = [5, 6, 9, 10];
  
var
  Map: TMap;
  
implementation

uses
  Classes, uUtils, uTile, uMapGenerator, uBox;

{ TMap }

function TMap.CellInMap(X, Y: Integer): Boolean;
begin
  Result := (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height);
end;

constructor TMap.Create;
begin
  Script := TScript.Create;
  Width := 150;
  Height := 150;
  Fill(False);
end;

destructor TMap.Destroy;
begin
  Script.Free;
  MiniMap.Free;
  inherited;
end;

procedure TMap.Fill(Ground: Boolean);
var
  X, Y, Z: Byte;
begin
  Script.Clear;
  for Z := 0 to Layers - 1 do
    for Y := 0 to Height - 1 do
      for X := 0 to Width - 1 do
      case Z of
        lrTerrain:
          if Ground then FMap[Y][X][Z] := GetGroundSet 
            else FMap[Y][X][Z] := -1;
        lrObj, lrCrt, lrPath:
          FMap[Y][X][Z] := lrNone;      
      end;    
  MakeMiniMap;  
end;

procedure TMap.Generate(AID: Byte);
var
  X, Y, Z, H, W: Byte;
  DR: TBeaRLibMap;

  procedure Ap(I: ShortInt);
  begin
    FMap[Y][X][lrTerrain] := I; 
    FMap[Y][X - 1][lrTerrain] := I; 
    FMap[Y - 1][X][lrTerrain] := I; 
    FMap[Y - 1][X - 1][lrTerrain] := I; 
  end;
  
begin
  Script.Clear;
  W := Width div 2;
  H := Height div 2;   
  SetLength(DR, W * H);
  CreateMap(W, H, AID, DR, W * H); 
  for Y := 1 to Height - 2 do
    for X := 1 to Width - 2 do
      if (DR[(X div 2) * H + (Y div 2)] = '#') then 
        Ap(-1) else Ap(GetGroundSet);
  MakeMap;  
  Terrain;
  MakeMiniMap;  
  for Z := lrObj to lrPath do
    for Y := 0 to Height - 1 do
      for X := 0 to Width - 1 do
        FMap[Y][X][Z] := lrNone;
end;

function TMap.GetGroundSet: Byte;
begin
  case Rand(1, 2) of
    1  : Result := Rand(5, 6);
    else Result := Rand(9, 10);
  end;   
end;

procedure TMap.MakeMap;
var
  X, Y: Byte;
begin
  for Y := 1 to Self.Height - 2 do
    for X := 1 to Self.Width - 2 do
    begin
      // Top
      if (FMap[Y][X][lrTerrain] in GroundSet)
        and not (FMap[Y - 1][X][lrTerrain] in GroundSet) then
          FMap[Y - 1][X][lrTerrain] := Rand(1, 2);
      // Down
      if (FMap[Y][X][lrTerrain] in GroundSet) 
        and not (FMap[Y + 1][X][lrTerrain] in GroundSet) then
          FMap[Y + 1][X][lrTerrain] := Rand(13, 14);
      // Left   
      if (FMap[Y][X][lrTerrain] in GroundSet) 
        and not (FMap[Y][X - 1][lrTerrain] in GroundSet) then
          FMap[Y][X - 1][lrTerrain] := 4;
      // Right   
      if (FMap[Y][X][lrTerrain] in GroundSet) 
        and not (FMap[Y][X + 1][lrTerrain] in GroundSet) then
          FMap[Y][X + 1][lrTerrain] := 7;   
         
      // Top Left
      if (FMap[Y][X][lrTerrain] in GroundSet)     
        and (FMap[Y - 1][X - 1][lrTerrain] = -1) then
          FMap[Y - 1][X - 1][lrTerrain] := 0;
      // Top Right
      if (FMap[Y][X][lrTerrain] in GroundSet)     
        and (FMap[Y - 1][X + 1][lrTerrain] = -1) then
          FMap[Y - 1][X + 1][lrTerrain] := 3;
      // Down Right
      if (FMap[Y][X][lrTerrain] in GroundSet)     
        and (FMap[Y + 1][X + 1][lrTerrain] = -1) then
          FMap[Y + 1][X + 1][lrTerrain] := 15;
      // Down Left
      if (FMap[Y][X][lrTerrain] in GroundSet)     
        and (FMap[Y + 1][X - 1][lrTerrain] = -1) then
          FMap[Y + 1][X - 1][lrTerrain] := 12;

      // Left Top Cor
      if (FMap[Y][X][lrTerrain] in GroundSet) 
        and (FMap[Y][X - 1][lrTerrain] in GroundSet)
        and (FMap[Y - 1][X][lrTerrain] in GroundSet) 
        and not (FMap[Y - 1][X - 1][lrTerrain] in GroundSet) then
          FMap[Y - 1][X - 1][lrTerrain] := -5;
      // Right Top Cor
      if (FMap[Y][X][lrTerrain] in GroundSet) 
        and (FMap[Y][X - 1][lrTerrain] in GroundSet)
        and not (FMap[Y - 1][X][lrTerrain] in GroundSet) 
        and (FMap[Y - 1][X - 1][lrTerrain] in GroundSet) then
          FMap[Y - 1][X][lrTerrain] := -4;
      // Left Down Cor
      if (FMap[Y][X][lrTerrain] in GroundSet) 
        and not (FMap[Y][X - 1][lrTerrain] in GroundSet)
        and (FMap[Y - 1][X][lrTerrain] in GroundSet) 
        and (FMap[Y - 1][X - 1][lrTerrain] in GroundSet) then
          FMap[Y][X - 1][lrTerrain] := -3;
      // Right Down Cor
      if not (FMap[Y][X][lrTerrain] in GroundSet) 
        and (FMap[Y][X - 1][lrTerrain] in GroundSet)
        and (FMap[Y - 1][X][lrTerrain] in GroundSet) 
        and (FMap[Y - 1][X - 1][lrTerrain] in GroundSet) then
          FMap[Y][X][lrTerrain] := -2;

      // Left Top Right Down Cor
      if (FMap[Y][X][lrTerrain] in GroundSet) 
        and not (FMap[Y][X - 1][lrTerrain] in GroundSet)
        and not (FMap[Y - 1][X][lrTerrain] in GroundSet) 
        and (FMap[Y - 1][X - 1][lrTerrain] in GroundSet) then
        begin
          FMap[Y - 1][X][lrTerrain] := -4;
          FMap[Y][X - 1][lrTerrain] := -3;
        end;  
      // Right Top Left Down Cor  
      if not (FMap[Y][X][lrTerrain] in GroundSet) 
        and (FMap[Y][X - 1][lrTerrain] in GroundSet)
        and (FMap[Y - 1][X][lrTerrain] in GroundSet) 
        and not (FMap[Y - 1][X - 1][lrTerrain] in GroundSet) then
        begin
          FMap[Y][X][lrTerrain] := -2;
          FMap[Y - 1][X - 1][lrTerrain] := -5;  
        end;             
    end;
end;

procedure TMap.MakeMiniMap;
var
  X, Y: Byte;
begin
  MiniMap.Free;
  MiniMap := TBitmap.Create;
  Minimap.PixelFormat := pf16bit;	
  Minimap.Width := Width;
  Minimap.Height := Height;
  with Minimap.Canvas do
    for X := 0 to Width - 1 do
      for Y := 0 to Height - 1 do   
        if (FMap[Y][X][lrTerrain] in GroundSet) then
          Pixels[X,Y] := clGreen else
        if (FMap[Y][X][lrTerrain] = -1) then
          Pixels[X,Y] := clBlue
        else
          Pixels[X,Y] := clBlue;         
end;

procedure TMap.LoadFromFile(const FileName: string);
var
  X, Y, Z: Byte;
  F: TStringList;
begin
  Script.LoadFromFile(FileName);
  F := TStringList.Create;
  F.LoadFromFile(FileName);
  for Z := 0 to SerializableLayers - 1 do
    for Y := 0 to Height - 1 do
      for X := 0 to Width - 1 do
        FMap[Y][X][Z] := Ord(F[(Z * Height) + Y][X + 1]) - 40;
  F.Free;
  MakeMiniMap;
end;

procedure TMap.SaveToFile(const FileName: string);
var
  S: string;
  X, Y, Z: Byte;
  F: TStringList;
begin
  F := TStringList.Create;
  for Z := 0 to SerializableLayers - 1 do
    for Y := 0 to Height - 1 do
    begin
      S := '';
      for X := 0 to Width - 1 do
        S := S + Chr(FMap[Y][X][Z] + 40);
      F.Append(S);
    end;  
  Script.SaveToFile(FileName);
  F.SaveToFile(FileName);       
  F.Free;
end;

procedure TMap.SetHeight(const Value: Integer);
begin
  FHeight := Value;
end;

procedure TMap.SetPath(Pt: TPoint; Value: ShortInt);
begin
  SetPath(Pt.X, Pt.Y, Value);
end;

procedure TMap.SetPath(X, Y: Byte; Value: ShortInt);
begin
  if CellInMap(X, Y) then
    FMap[Y][X][lrPath] := Value;
end;

procedure TMap.SetWidth(const Value: Integer);
begin
  FWidth := Value;
end;

procedure TMap.Terrain;
var
  X, Y: Byte;
begin
  for Y := 1 to Height - 2 do
    for X := 1 to Width - 2 do
      if (FMap[Y][X][lrTerrain] in GroundSet) then
        FMap[Y][X][lrTerrain] := GetGroundSet;
end;

initialization
  Map := TMap.Create;

finalization
  Map.Free;

end.
